perm filename RHY.F4[MSS,LCS] blob sn#254538 filedate 1976-12-09 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		DIMENSION E(100),F(100),G(100)
C00005 ENDMK
CāŠ—;
	DIMENSION E(100),F(100),G(100)
204	TYPE 110
110	FORMAT(' TYPE RHYTHM LINE 1  --'$)
210	FORMAT(' TYPE RHYTHM LINE 2  --'$)
310	FORMAT(100F)
	ACCEPT 310,E
	TYPE 210
	ACCEPT 310,F
	X=0
	DO 100 K=1,100
	IF(E(K).EQ.0)GO TO 101
	KE=K
	A=4/E(K)
	E(K)=A
100	X=X+A
101	Y=0
	DO 200 K=1,100
	IF(F(K).EQ.0)GO TO 201
	KF=K
	A=4/F(K)
	F(K)=A
200	Y=Y+A
201	IF(ABS(Y-X).LT..01)GO TO 202
	TYPE 203
	GO TO 204
203	FORMAT(' MISMATCH')
202	CALL RHYTOT(E,KE)
	CALL RHYTOT(F,KF)
	K=1
	L=1
	M=0
19	KK=K
	LL=L
1	SM=10000
	K=K+1
	IF(K.GT.KE)GO TO 10
4	L=L+1
	Y=F(L)
	B=Y-F(L-1)
	IF(B.LT.SM)SM=B
2	X=E(K)
	A=X-E(K-1)
C  A AND B HAVE TRUE DURATIONS NOW
	IF(A.LT.SM)SM=A
C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
	IF(ABS(X-Y).LT..01)GO TO 3
C JUMP IF EQUAL RHYTHS
	IF(X.GT.Y)GO TO 4
	K=K+1
C STEP FORWARD UNTIL X IS .GT. Y
	GO TO 2
3	IF(K.NE.KK+1)GO TO 13
	IF(L.NE.LL+1)GO TO 14
	M=M+1
	G(M)=E(KK)
	GO TO 19
13	IF(L.NE.LL+1)GO TO 15
	DO 16 J=KK,K-1
	M=M+1
16	G(M)=E(J)
	GO TO 19
14	DO 17 J=LL,L-1
	M=M+1
17	G(M)=F(J)
	GO TO 19
15	XM=SM-.001
	M=M+1
	P=E(KK)
	G(M)=P
7	KK=KK+1
	LL=LL+1
	YM=SM*1.5
C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
	S=P
	T=P
27	A=E(KK)
	B=F(LL)
	IF(ABS(A-B).LT..01)GO TO 19
	X=A-P
	Y=B-P
	S=E(KK-1)
	T=F(LL-1)
9	IF(A-S.LT.X)X=A-S
	IF(B-T.LT.Y)Y=B-T
	IF(A.GT.B)GO TO 8
	KK=KK+1
62	IF(X.GT.YM)GO TO 5
	IF(X.EQ.0)GO TO 27
	P=P+SM
25	M=M+1
	G(M)=P
	GO TO 27
5	J=X/XM
	P=P+SM*J
	GO TO 25
8	X=Y
	LL=LL+1
	GO TO 62
10	M=M+1
	G(M)=E(KE)
	TYPE 410,(E(K),K=1,KE)
	TYPE 410,(F(K),K=1,KF)
	TYPE 410,(G(K),K=1,M)
410	FORMAT(12F7.3)
	END

	SUBROUTINE RHYTOT(E,KE)
	DIMENSION E(1)
	KE=KE+1
	X=E(1)
	E(1)=0
	DO 50 K=2,KE
	Y=E(K)
	E(K)=E(K-1)+X
50	X=Y
	END